library(tidyverse)
library(ggdendro)
library(here)
library(plotly)
library(cluster)
library(ggfortify)
library(broom)
library(stats)
source(here::here("code/plota_solucoes_hclust.R"))
Esta análise, realizada no contexto da disciplina Ciência de Dados 1 , tem por objetivo identificar agrupamentos em dados sobre as partitidas oficias que a seleção Brasileira de futebol participou. Essa análise serve de mote para trabalharmos com algumas técnicas de agrupamento de múltiplas (> 2) dimensões utilizando a técnica k-means. Para está analise utilizamos uma base de dados deste site onde fizemos uma filtragem para seleciona apenas os jogos da seleção Brasileira.
games = read_csv("../data/international-football.csv")
jogos_brasil = games %>%
filter(home_team == "Brazil" | away_team == "Brazil") %>%
mutate(time1 = "Brazil",
time2 = if_else(home_team == "Brazil", away_team, home_team),
score1 = if_else(home_team == "Brazil", home_score, away_score),
score2 = if_else(home_team == "Brazil", away_score, home_score)
)
historicos = jogos_brasil %>%
group_by(time2) %>%
summarise(
jogos = n(),
ganhou = sum(score1 > score2) / n(),
empatou = sum(score1 == score2) / n(),
perdeu = sum(score1 < score2) / n()
)
historicos = historicos %>%
filter(jogos > 2)
p <- historicos %>%
ggplot(aes(x = ganhou,
y = jogos,
text = paste("Seleção:", time2,
"\nVitorio:",ganhou,
"\nPerdeu:",perdeu,
"\nEmpatou:",empatou))) +
geom_point(size = 4,
color = "#938BA1") +
labs(y = "Quantidade de Jogos",
x = "Proporção")
ggplotly(p, tooltip = "text") %>%
layout(autosize = F)
agrupamento_h = historicos %>%
as.data.frame() %>%
column_to_rownames("time2") %>%
select(ganhou) %>%
dist(method = "euclidian") %>%
hclust(method = "ward.D")
ggdendrogram(agrupamento_h, rotate = T, size = 2, theme_dendro = F) +
labs(y = "Dissimilaridade", x = "", title = "Dendrograma")
* Podemos observar em termo de Dissimilaridade a divisão de grupos bem proximas.
Com o intuito de busca grupos onde se encaixa os adversarios da seleção Brasileira podemos observar utilizando o algoritimo k-means e o Sillhoutte plot..
historico_t = historicos %>%
mutate(jogos = log10(jogos))
atribuicoes = tibble(k = 1:6) %>%
group_by(k) %>%
do(kmeans(select(historico_t,ganhou, jogos),
centers = .$k,
nstart = 10) %>% augment(historico_t)) # alterne entre filmes e filmes_t no augment
## Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
## Warning in bind_rows_(x, .id): binding character and factor vector,
## coercing into character vector
atribuicoes_long = atribuicoes %>%
gather(key = "variavel", value = "valor", -time2, -k, -.cluster, -jogos)
atribuicoes %>%
ggplot(aes(x = ganhou, y = jogos, label = time2, colour = .cluster)) +
geom_point() +
facet_wrap(~ k) + scale_y_log10()
# A silhoueta
dists = select(historico_t, ganhou, jogos) %>% dist()
set.seed(31)
km = kmeans(select(historico_t, ganhou, jogos),
centers = 4,
nstart = 10)
silhouette(km$cluster, dists) %>%
plot(col = RColorBrewer::brewer.pal(4, "Set2"))
set.seed(123)
explorando_k = tibble(k = 1:15) %>%
group_by(k) %>%
do(
kmeans(select(historico_t, -time2),
centers = .$k,
nstart = 20) %>% glance()
)
explorando_k %>%
ggplot(aes(x = k, y = betweenss / totss)) +
geom_line() +
geom_point()
Consideramos que á partir do valor 5 não ocorre uma mudança considerada na linha da curva então podemos considerar k = 4.
Organizando os dados segundo os grupos identificados:
d.scaled.km.long = km %>%
augment(historico_t) %>%
gather(key = "variável",
value = "valor",
-time2, -.cluster)
d.scaled.km.long %>%
ggplot(aes(x=`variável`, y=valor, group=time2, colour=.cluster)) +
geom_line(alpha = .5) +
facet_wrap(~ .cluster)